perm filename NOTB.FAI[NEW,LCS] blob
sn#217879 filedate 1977-03-21 generic text, type T, neo UTF8
00010 C***** SUBRS NOTES, BMX, ACSHFT ***********
00055
00100 ;SUBROUTINE NOTES
00200 ;COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00300 ;COMMON/SCX/RHY(4),JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ
00310 ;COMMON /XRN/RN(4000) /DPY/ST(4000),WDS(250),MEDIT,GO ;
00400 ;COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA
00500 ;1,DBST,NFLG,IXX,ISEMI,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA
00600 1 /ALF/CLF,JQX,D,KQ,JG,X,ACC,T,Y,LL,RZ,RC,INP(61) /POS/POS1,POS2
00710 ;COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK
00730 ;DIMENSION R(10,80)
00740 ;EQUIVALENCE (R,RN(3001)),(STEM,RN(2999)),(STUP,RN(3921))
00745 ;1,(RMODE2,RN(3918))
00750 ;DATA ACMV/2.3/
01600 NOTB: 0 ; K=IZ+1
01800 MOVE 1,IZ
01815 SETZ 2,
01820 NB70X: MOVE 3,V(2) ; DO 70 KQ=1,IZ
01830 JUMPG 3,NB70 ;IF(JG.GT.0)GO TO 70
01832 FIXX(3) ;JG=V(KQ)
01837 IDIVI 3,=100 ;JG=-JG/100
01840 MOVNS 3
01844 CAIL 3,=100 ;IF(JG.GE.100)GO TO 170
01847 JRST NB170
01851 CAILE 3,=10 ;IF(JG.GT.10)GO TO 70
01860 ; TO GET THE RIGHT ITEM COUNT WITH CHORDS, ETC.
01870 NB170: SOJ 1, ; K=K-1
01880 NB70: AOJ 2, ;CONTINUE
01885 CAMGE 2,IZ
01887 JRST NB70X
01890
01900 MOVE 2,POS2 ;D=(POS2-POS1)/K
01910 FSBR 2,POS
01920 TLC 1,232000 ; FLOAT K
01930 FADR 1,1
01940 FDVR 2,1
01950 MOVEM 2,@(16)
01960 JRA 16,1(16) ; RETURN
02000 ; D WILL SPACE ALL ITEMS EVENLY FOR NOW
02100
02465 ; IN V ARRAY -- NOTES ARE 1-98, 1000-1000000; NEG. VALUES ARE CHORD NOTES.
02500 X=V(KQ)
02510 ;IF(X)GO TO 27
02520 C NEXT SORTS OUT ORDER OF CHORD
02530 ;RZ=V(KQ+1)
02540 ;IF(RZ.GT.0)GO TO 27
02550 ;IF(RZ.GT.-99)GO TO 327
02555 ;IF(RZ.GT.-1000)GO TO 27
02557 ; SKIPS NON-NOTES (NOTES ARE -1→-98; ¬1000→[ACCIS])
02560 ;327 RZ=AMOD(X,100.0)
02570 ;57 LL=KQ
02580 ;Y=0
02590 ;RA=RZ
02600 ;37 LL=LL+1
02605 ;T=RA
02610 ;RA=-V(LL)
02620 ;IF(RA)GO TO 27
02630 ;IF(RA.LT.99)GO TO 427
02635 ;IF(RA.LT.1000)GO TO 27
02637 ; EXITS WITH NON-NOTES
02640 ;427 RA=AMOD(RA,100.0)
02650 ; GETS RID OF ACCI. FOR NOW
02660 ;IF(Y)127,97,67
02670 ; Y IS STEM DIRECTION. -1=DOWN, 1=UP
02680 9;Y=RA-T
02700 ;GO TO 37
02705 ;67 IF(RA.LT.RZ)V(LL)=-RA-7
02707 ; TRAP FOR NOTE IN WRONG OCT. (CONFUSES STEM DIRECTION.)
02710 ;IF(RA.GE.T)GO TO 37
02720 ;227 CALL EXCH(V(LL),V(LL-1))
02730 ; NOW START OVER AGAIN
02740 ;GO TO 57
02745 ;127 IF(RA.GT.RZ)V(LL)=-RA+7
02750 ;IF(T.GT.RA)GO TO 37
02760 ;GO TO 227
02900
03210 ;27 ACC=0